Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/myvcs/myvcs.pas

Pascal/Delphi Source File | 1995-12-22 | 5KB | 202 lines

library MyVCS;

uses
  Forms,
  SysUtils,
  Classes,
  Dialogs,
  WinTypes,
  WinProcs,
  VirtIntf,
  ToolIntf,
  VCSIntf,
  MyVcsAbt in 'MYVCSABT.PAS' {AboutBox},
  MyVcsInf in 'MYVCSINF.PAS' {MyVCSInfo},
  MyVcsOpn in 'MYVCSOPN.PAS' {VCSOpenForm};

type
  TMyVCSClient = class(TIVCSClient)
  public
    function GetIDString: string; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetMenuName: string; override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    function GetVerbState(Index: Integer): Word; override;
    procedure ProjectChange; override;
  end;

var
    WindowHandle: HWnd;
    TempStr : String;

const
    MyVCSClient: TMyVCSClient = nil;
    ToolInterface: TIToolServices = nil;

procedure OpenAFile;
begin
    if ToolInterface <> nil then
    begin
        VCSOpenForm := TVCSOpenForm.Create (Application);
        VCSOpenForm.ShowModal;
        if VCSOpenForm.ModalResult = idOK then
        begin
            TempStr := VCSOpenForm.Label4.Caption + '\' + VCSOpenForm.Edit1.Text;
            if not ToolInterface.OpenFile (TempStr) then
                MessageDlg ('Could not open ' + VCSOpenForm.Edit1.Text, mtWarning, [mbOK], 0);
        end;
        VCSOpenForm.Destroy;
    end;
end;

procedure ShowVCSAboutBox;
begin
    AboutBox := TAboutBox.Create (Application);
    AboutBox.ShowModal;
    AboutBox.Destroy;
end;

procedure ShowVCSFormCount;
var
    i : Integer;
begin
    if ToolInterface <> nil then
    begin
        i := ToolInterface.GetFormCount;
        TempStr := Format ('Form Count: %d', [i]);
        MessageDlg (TempStr, mtInformation, [mbOK], 0);
    end;
end;

procedure ShowVCSUnitCount;
var
    i : Integer;
begin
    if ToolInterface <> nil then
    begin
        i := ToolInterface.GetUnitCount;
        TempStr := Format ('Unit Count: %d', [I]);
        MessageDlg (TempStr, mtInformation, [mbOK], 0);
    end;
end;

procedure CloseVCSCurrentProject;
begin
    if ToolInterface <> nil then
    begin
        TempStr := ToolInterface.GetProjectName;
        if TempStr <> '' then
            if MessageDlg ('Close project ' + TempStr + '?', mtConfirmation, mbOKCancel, 0) = idOK then
                if not ToolInterface.CloseProject then
                    MessageDlg ('Could not close ' + TempStr + '!', mtInformation, [mbOK], 0);
    end;
end;

procedure CloseVCSCurrentFile;
begin
    if ToolInterface <> nil then
    begin
        TempStr := ToolInterface.GetCurrentFile;
        if TempStr <> '' then
            if MessageDlg ('Close file ' + TempStr + '?', mtConfirmation, mbOKCancel, 0) = idOK then
                if not ToolInterface.CloseFile (TempStr) then
                    MessageDlg ('Could not close ' + TempStr + '!', mtInformation, [mbOK], 0);
    end;
end;

procedure ShowVCSInfo;
var
    i : Integer;
begin
    if ToolInterface <> nil then
    begin
        MyVCSInfo := TMyVCSInfo.Create(Application);
        MyVCSInfo.Edit1.Text := ToolInterface.GetProjectName;
        if ToolInterface.GetUnitCount > 0 then
            for i := 0 to ToolInterface.GetUnitCount - 1 do
                MyVCSInfo.UnitListBox.Items.Add (ToolInterface.GetUnitName(i));
        if ToolInterface.GetFormCount > 0 then
            for i := 0 to ToolInterface.GetFormCount - 1 do
                MyVCSInfo.FormListBox.Items.Add (ToolInterface.GetFormName(i));
        MyVCSInfo.ShowModal;
        MyVCSInfo.Destroy;
    end;
end;

function TMyVCSClient.GetIDString: String;
begin
    result := 'Cervasio.Vcs';
end;

procedure TMyVCSClient.ExecuteVerb(Index: Integer);
begin
    Case Index of
        0 : ShowVCSInfo;
        1 : OpenAFile;
        2 : ShowVCSFormCount;
        3 : ShowVCSUnitCount;
        5 : CloseVCSCurrentProject;
        6 : CloseVCSCurrentFile;
        8 : ShowVCSAboutBox;
    end;
end;

function TMyVCSClient.GetVerb(Index: Integer): string;
begin
    case Index of
        0 : result := 'Project &Info...';
        1 : result := '&Open File...';
        2 : result := '&Form Count...';
        3 : result := '&Unit Count...';
        4 : result := '';
        5 : result := 'Close Current &Project';
        6 : result := '&Close Current File';
        7 : result := '';
        8 : result := '&About MyVCS...';
    end;
end;

function TMyVCSClient.GetVerbCount: Integer;
begin
    result := 9;
end;

function TMyVCSClient.GetVerbState(Index: Integer): Word;
begin
    result := vsEnabled;
end;

procedure TMyVCSClient.ProjectChange;
begin
    if ToolInterface <> nil then
    begin
        { handle anything needed when the project changes }
    end;
end;

function TMyVCSClient.GetMenuName: String;
begin
    result := '&Workgroup';
end;


function MyVCSInit (VCSInterface: TIToolServices): TIVCSClient; export;
begin
    ToolInterface := VCSInterface;
    if ToolInterface <> nil then
    begin
        MyVCSClient := TMyVCSClient.Create;
        WindowHandle := VCSInterface.GetParentHandle;
        result := MyVCSClient;
    end
    else
        result := nil;
end;

exports
    MyVCSinit name VCSManagerEntryPoint resident;

begin
end.